Software Vault: The Diamond Collection/The Diamond Collection (Software Vault)(Digital Impact).ISO/cdr13/aurora2c.zip/EXT.AML

Text File | 1995-04-07 | 73KB | 2,801 lines

// ───────────────────────────────────────────────────────────────────
// The Aurora Editor v2.0
// Copyright 1993-1995 nuText Systems. All Rights Reserved Worldwide.
//
// Editor library extensions (included by MAIN.AML)
//
// *You should be very familiar with AML before making changes here*
// If you have made any changes, save this file and select 'Recompile
// the Editor' <alt f2> from the Set menu. Exit and re-enter the
// editor for your changes to take effect.
// ───────────────────────────────────────────────────────────────────

// ───────────────────────────────────────────────────────────────────
//  All windows
// ───────────────────────────────────────────────────────────────────

  object  a

    // get the drive and path portion of a filespec
    function  getpath (file)
      return  file [1 : pos "\\" file 'r']
    end

    // get the name and extension portion of a filespec
    function  getname (file)
      return  file [(pos "\\" file 'r') + 1 : 0]
    end

    // get the extension portion of a filespec
    function  getext (file)
      p = pos '.' file 'r'
      if? p file [p : TO_END] ''
    end

    // append a default extension for filenames that don't have one
    function  defext (file extension)
      if pos '.' file then
        file
      else
        file + '.' + extension
      end
    end

    // force a filename to have an extension
    function  forceext (file ext)
      p = pos '.' file 'r'
      return (if? p  file [1 : p]  file + '.') + ext
    end

    // generate <shiftdown>, <shiftup> events from raw <shiftkey> event
    function  <shiftkey> (newstate oldstate)
      send ( if newstate & 3 and not (oldstate & 3) then
               "shiftdown"
             elseif oldstate & 3 and not (newstate & 3) then
               "shiftup"
             end )
    end

    // generate multi-key events
    function  prefix (keycode)
      keyname = locase (getkeyname keycode)
      say  keyname + "<more...>"
      keyname2 = locase (getkeyname (getkey))
      queue  keyname + keyname2
      // allow the <ctrl> key to be held down...
      if keyname [1:5] == "<ctrl" and keyname2 [1:5] == "<ctrl" then
        queue keyname + '<' + keyname2 [7 : TO_END]
      end
      display
    end

    // repeat keys for a user-specified number of times
    function  askrepkey
      var keystring
      var i
      say "Enter keys to repeat, then <esc>:"
      hidecursor
      keycode = getkey
      while keycode <> <esc> do
        keystring = keystring + (char2 keycode)
        keycode = getkey
      end
      if keystring then
        count = ask "Number of repetitions"
        if count then
          strlen = sizeof keystring
          while count do
            j = 1
            while j < strlen do
              queuekey (bin2int keystring [j : 2])
              j = j + 2
            end
            repeat
              dispatch
            until not event?
            count = count - 1
          end
        end
      end
    end

    // a simple file picklist
    function  picklist (filespec title)
      filespec = qualify filespec (getbufname)
      repeat
        filespec = askfile filespec  filespec + title _FmgrSort _FmgrOpt
      until not (filespec and (dir? filespec))
      return filespec
    end

    // execute a fully qualified DOS program
    // (saving and restoring the current path)
    function  os (program options)
      cp = getcurrpath
      currpath (getpath (getbufname))
      r = exec program options
      currpath cp
      return r
    end

    // shell to DOS by executing COMMAND.COM
    function  shell
      os (getenv "COMSPEC") "ch"
    end

    // execute DOS commands, programs, and .bat files
    function  run (file options)
      if file then
        os (getenv "COMSPEC") + " /c " + file  options
      else
        shell
      end
    end

    // execute DOS commands or programs and capture the output
    // via DOS piping (will not capture .bat file output)
    function  runcap (command options)
      _cap = _cap + 1
      capfile = qualify  "capture." + _cap  (getbufname)
      run  command + '>' + capfile  options
      open capfile
      deletefile capfile
    end

    // translate an AML compiler error code to an error message
    function  errormsg (error)
      case error
        when 1001  "Can't open file"
        when 1002, 1003  "Read error"
        when 1004  "Not an executable macro file"
        when 1031  "Write error"
        when 1032  "Can't open compiler output file"
        when 1101  "No closing quote"
        when 1102  "No closing bracket"
        when 1103  "Invalid symbol"
        when 1104  "Invalid key or event"
        when 1301  "No terminator"
        when 1302  "Unexpected end of source"
        when 1303  "No closing parenthesis"
        when 1310  "Unexpected argument"
        when 1311  "Unexpected terminator"
        when 1312  "Unexpected function"
        when 1313  "Unexpected operator"
        when 1319  "Identifier '" + (geterror 's') + "' not defined"
        when 1320  "Bad assignment"
        when 1330  "Bad when clause"
        when 1336  "Improperly placed break"
        when 1337  "Invalid reference"
        when 1501  "Can't open include file " + (geterror 's')
        when 1502  "Include level exceeded"
        when 1503  "Can't include compiled file in expression"
        when 1504  "Include must be at top level"
        when 1505  "Define can't be nested"
        when 1506  "Function must be at top level"
        when 1507  "Can't redefine builtin function"
        when 1508  "Duplicated function argument"
        when 1509  "Object statement not permitted"
        when 1701  "Too many variables"
        when 1702  "Too many function arguments"
        when 1703  "Function or expression too large"
        when 1704, 1705, 1707   "Internal stack overflow"
        when 1706  "Out of symbol space"
        otherwise "Fatal compilation error " + error
      end
    end

    // compile a macro with error messages
    // the cursor is moved to any syntax errors
    function  compilemacro2 (source dest msg)
      if not source then
        source = getbufname
      end
      say (if? msg msg "Compiling...")
      source = qualify (defext source "aml") (getbufname)
      error = compilemacro source (if? dest dest (forceext source 'x'))

      if error then

        // get additional error info
        column = geterror 'k'
        line = geterror 'l'
        file = geterror 'f'

        // translate error code to an error message
        msg = errormsg error

        // position the cursor to the error
        if error <> 1001 and (open file) then
          gotopos column line
          send "onfound"
        end

        // display the error
        msgbox  file + " (line " + line + ", col " + column + "): " + msg
                "Error!" 'b'
      else
        say "Done."
      end

      return error
    end

    // regenerate the editor boot macro (a.x)
    function  regen (msg)
      dest = bootpath "main.x"
      error = compilemacro2 (bootpath "main.aml") dest msg
      if not error then
        bootfile = bootpath "a.x"
        deletefile bootfile
        renamefile dest bootfile
      end
      return error
    end

    // regenerate the editor boot macro (a.x) with a message
    function  recompile
      if not regen then
        msgbox "Exit and re-enter for changes to take effect. "
      end
    end

    // regenerate the editor boot macro (a.x) with a message,
    // and integrate current config variables in compilation
    function  saveconfig
      configx = bootpath "config.x"
      saveobject "prf" configx
      regen "Saving..."
      deletefile configx
    end

    // load and run a compiled macro file
    function  includemacro2 (macrofile)
      includemacro (qualify (forceext
                 (if? macrofile macrofile (getbufname)) 'x') (getbufname))
    end

    // load, run, and discard a compiled macro file
    function  runmacro2 (macrofile)
      runmacro (qualify (forceext
                 (if? macrofile macrofile (getbufname)) 'x') (getbufname))
    end

    // send a string to the default printer device
    function  printstr (string)
      if string then
        fileid = openfile _PrtDev 'w'
        if fileid then
          writefile fileid string
          closefile fileid
        end
      end
    end

    // open a new file
    function  opennew (file options)
      prevbufname = getbufname
      buffer = createbuf
      if buffer then
        setbufname (qualify (if? file file "NEW.TXT") prevbufname)
        openbuf buffer options
      end
    end

    // toggle the video mode between 80x25 and 80x50
    function  togglemode
      videomode 80 (if? getvidrows == 25  50 25)
    end


    // search/replace with verification
    // (returns the number of replacements made)
    function  replver (searchstr replstr options)

      var title
      var count

      repeat
        length = find searchstr options
        if length then

          if not title then
            title = gettitle
            settitle  "Replace (Yes/No/All/One/Reverse/Undo/Quit)? "
            // remove global for next find
            options = sub 'g' '' options
          end

          send "onfound" length

          // get keycode and convert to lower case
          p = getkey | 020h
          case p

            when <y>, <o>, <a>
              undobegin
              l = (replace searchstr replstr  (sub 'r' '' options) + "*z") - 1
              if not (pos 'r' options) then
                right l
              end
              count = count + 1
              if p <> <y> then
                length = ''
                if p == <a> then
                  count = count + (replace searchstr replstr  options + "az")
                end
              end
              undoend

            when <u>
              if count then
                undo
                count = count - 1
                if pos 'r' options then
                  right 1
                else
                  if getcol == 1 then
                    if up then
                      col 16000
                    end
                  else
                    left l
                  end
                end
              end

            when <n>
               // do nothing

            when <r>
               options = if? (pos 'r' options) (sub 'r' '' options)  options + 'r'

            otherwise
              if not count then
                count = '0'
              end
              break
          end
        end
      until not length

      if title then
        settitle title
      end

      return count
    end


    // search for a multi-string search argument
    function  search (searchstr reverse rep refopt refrepl)

      var replstr
      var options

      // split up search multi-string
      if pos '/' searchstr then
        n = splitstr '' searchstr  ref searchstr  ref replstr  ref options
        if n > 1 then
          if n == 2 then
            options = replstr
            replstr = ''
            // case sensitive
            if not options then
              options = 'c'
            end
          end
        end
      end

      if searchstr then

        // default options
        if not options then
          options = _SearchOpt
          if n > 2 then
            options = options + _ReplaceOpt
          end
        end

        // reverse search direction if specified
        if reverse then
          options = if pos 'r' options then
                      sub 'r' '' options
                    else
                      options + 'r'
                    end
        end

        // remove global for repeat find
        if rep and (pos 'g' options) then
          options = sub 'g' '' options
        end

        // return values for calling function to check
        refopt  = options
        refrepl = n >= 3

        // resurface marked window for block search
        if pos 'b' options then
          buffer = getmarkbuf
          if buffer and buffer <> getcurrbuf then
            currwin (getcurswin (getcurrcurs buffer))
          end
        end

        // search and replace
        if n >= 3 then

          // do the replace
          if pos 'a' options then
            replace searchstr replstr options
          else
            replver searchstr replstr options
          end

        // search only
        else
          find searchstr options
        end
      end
    end

    // hot key for the file mgr and file picklists
    function onhotkey (character)
      searchstr = '^[~]' + (upcase character)
      if find searchstr 'x' then
        adjustrow getviewrows / 3
        return
      else
        line = getrow
        gotopos 1 1
        if find searchstr 'x*' then
          adjustrow getviewrows / 3
          return
        end
        // not found
        beep 320 70
        row line
      end
    end


  object  mon

    // erase key macros
    function  erasekey2 (options)
      if erasekey options then
        _kd = TRUE
        display
        say (if? (pos options 'a') "All keys macros erased"
                                   "Scrap key macro erased")
      end
    end

    // toggle the key macro record mode
    function  record
      if not playing? then
        _kd = TRUE
        if not setting? 'R' then
          erasekey
          record_on = TRUE
        end
        setting 'R' TOGGLE
        say "Record" + (if? record_on "ing..." " OFF")
      end
    end

    // play a key macro
    function  play (keymacro)
      setdisplay OFF
      if not (playkey keymacro) then
        say "No key macro to play." 'b'
      end
      setdisplay ON
    end


// ───────────────────────────────────────────────────────────────────
//  Edit windows and File Manager windows
// ───────────────────────────────────────────────────────────────────

  object  edit_fmgr

    // close all windows
    function  closeall (options)
      setxobj "__G" ON 'a'
      begdesk
      while getwincount and (send "close" options) end
      enddesk
      setxobj "__G" OFF 'a'
    end

    // move the cursor to any edge of a mark
    function  gotomark (options)
      if mark? then

        window = getcurswin (getcurrcurs (getmarkbuf))
        if window then
          currwin window
        end

        // left or right
        if pos 'l' options then
          col (getmarkleft)
        elseif pos 'r' options then
          col (getmarkright)
        end

        // top or bottom
        if pos 't' options then
          row (getmarktop)
        elseif pos 'b' options then
          row (getmarkbot)
        end

        if window then
          send "onfound"
        end

      else
        say "Block not found" 'b'
      end
    end

    // goto a bookmark with message
    function  gotobook2 (bookmark)
      msg = "Bookmark '" + bookmark + "'"
      if gotobook bookmark then
        window = getcurswin (getcurrcurs (getbookbuf bookmark))
        if window <> getcurrwin then
          currwin window
        end
        display
        say msg
      else
        say msg + " not found"  'b'
      end
    end

    // prompt to goto a bookmark
    function  askbook (msg)
      askx (if? msg msg "Bookmark Name") "_book" "gotobook2"
    end

    // cycle though all existing bookmarks
    function  cyclebook
      repeat
        l = _lb
        bookmark = if? l (getprevbook l) (getcurrbook)
        buffer = getcurrbuf
        while not bookmark and buffer do
          buffer = getprevbuf buffer
          bookmark = getcurrbook buffer
        end
        _lb = bookmark
      until bookmark or not l
      gotobook2 bookmark
    end

    // print the current buffer or mark
    function  print (options)
      printstr _PrtIni
      header = _PrtHdr
      if not (posnot ' ' header) or (dir? (getbufname)) then
        date = getdate
        header = getbufname + "   (" + date [posnot ' ' date : TO_END] +
                                 ' ' + gettime + ')'
      end
      if not ( if pos 'b' options  then printblock _PrtDev header ''
                else    printbuf _PrtDev header end ) then
        say "Print failed" 'b'
      end
    end

    // replace/append/cancel or ok/cancel menus
    function  askrac (file menuname)
      if _ConRpl == 'y' and (locatefile file) then
        locase (popup (if? menuname menuname "rac" )
                        file + " Exists" +
                        (if? menuname == "ok" ". Replace?")) [1]
      else
        'r'
      end
    end

    // generic prompt to change a configuration variable
    function  askc (pstring variable history)
      newvalue = ask pstring history (lookup variable "prf")
      if newvalue then
        setxobj variable newvalue "prf"
      end
    end

    // prompts to change specific configuration variables
    function  askbinary  askc "Binary Line Length"  "BinaryLength"     end
    function  askdelim   askc "Line Delimiter String in Hex" "LineDlm" end
    function  asktabw    askc "Tab Width"      "TabWidth"    end
    function  asktabv    askc "Variable Tabs"  "VarTabs"     end
    function  asklmarg   askc "Left Margin"    "LMargin"     end
    function  askrmarg   askc "Right Margin"   "RMargin"     end
    function  askclip    askc "Clipboard Name" "ClipName"    end
    function  askprthdr  askc "Current Header/Footer" "PrtHdr" end

    // generic prompt with command execution
    function  askx (pstring history func parm2)
      parm1 = ask pstring history
      if parm1 then
        send func parm1 parm2
        if history then
          addhistory history parm1
        end
        return 1
      end
    end

    // open prompt
    function  askopen
      file = ask "[file/ibcenz] Open" "_load"
      if file then
        // addhistory not needed for open
        open file
      end
    end

    // open binary prompt
    function  askopenb
      askx "File to open in Binary Mode" "_load" "open" 'b'
    end

    // macro expression prompt
    function  askeval
      if askx "Macro Expression" "_cmd" "eval" then
        error = geterror 'c'
        if error then
          msgbox "Expression column " + (geterror 'k') +
                 ": " + (errormsg error)  "Error" 'b'
        end
      end
    end

    // prompt to include a macro
    function  askimacro
      askx "Include Macro File"  "_load" "includemacro2"
    end

    // prompt to run a macro
    function  askrmacro
      askx "Run Macro File"  "_load" "runmacro2"
    end

    // prompt to compile a macro
    function  askcmacro
      askx "Compile Macro File"  "_load" "compilemacro2"
    end

    // macro picklist
    function  pickmacro
      macro = askfile getbootpath + "MACRO\\*.X" "Select a macro to run"
                      _FmgrSort _FmgrOpt "maclist"
      if macro then
        runmacro macro
      end
    end

    // DOS command prompt
    function  askrun
      askx "DOS Command" "_os" "run" "ck"
    end

    // prompt to capture DOS output
    function  askruncap
      askx "Capture DOS Output" "_os" "runcap" 'c'
    end

    // open key macro file with messages
    function  openkey2 (file)
      if openkey file then
        say (getname file) + " loaded"
      else
        say "Load failed" 'b'
      end
    end

    // prompt to open a key macro file
    function  askopenkey
      file = ask "Key macro filename" "_load"
      if file then
        openkey2 (qualify (defext file "mac") (getbufname))
      end
    end

    // prompt to save current key macros
    function  asksavekey
      file = ask "Save current key macros as" "_load"
      if file then
        file = qualify (defext file "mac") (getbufname)
        if pos (askrac file "ok") "or" 'i' then
          if not savekey file then
            say "Save failed" 'b'
          end
        end
      end
    end

    // search files for a string in multi-string format with msgs
    function  searchfiles (s)
      var searchstr
      var filespec
      var options
      n = splitstr '' s  ref searchstr  ref filespec  ref options
      if n < 3 then
        options = _SearchOpt
        if n < 2 then
          filespec = '.'
        end
      end
      if searchstr then
        r = scanfiles filespec searchstr options
        if r <= 0 then
          say (if? r filespec s) + " not found" 'b'
        else
          addhistory "_find" (joinstr '' searchstr options)
        end
      end
    end

    // prompt to scan files for a string
    function  askscan
      scanstring = if _PromptStyle == 'd' then
                     scandlg
                   else
                     ask "[string/files/iwx] Scan" "_scan"
                   end
      if scanstring then
        searchfiles scanstring
        addhistory "_scan" scanstring
      end
    end

    // reload the current file from disk
    function  reopen (file)
      open (if? file file getbufname) 'r'
    end

    // open last file or directory
    function  openlast
      file = gethiststr "_load"
      if file then
        open file
      end
    end

    // open an AML configuration file in boot directory
    function  opencfg (file)
      open (bootpath  file + ".aml")
    end

    // quick reference help
    function  quickref (options openopt)
      quickfile = getbootpath + (if? options <> 'o' "DOC\\") +
                    case options [1]
                      when 'l'  "LANGUAGE.DOX"
                      when 'f'  "FUNCTION.DOX"
                      when 'q'  "QUICKFUN.DOX"
                      when 'o'  "ORDERFRM.DOC"
                      when 't'  "TIPS.DOX"
                      otherwise "USER.DOX"
                    end
      if (wintype? "edit") and (pos 'w' options) then
        wordstr = send "getword" "a-zA-Z0-9?"
      end
      open quickfile openopt
      if wordstr then
        gotopos 1 1
        // find string in reference
        if find (char 0ffh) + wordstr + (char 0ffh) then
          right
          send "onfound" (sizeof wordstr)
        // not found? then try function header in EXT.AML
        elseif poschar 'fq' options then
          close
          ext = bootpath "EXT.AML"
          closeit = _MultCopy == 'n' and not (findbuf ext)
          open ext openopt
          gotopos 1 1
          n = find "function #" + wordstr  'x'
          if n then
            send "onfound" n
          else
            // still not found? then go back to the reference
            if closeit then
              close
            end
            open quickfile openopt
          end
        end
      end
    end

    // popup menu to change the default prompt style
    function  askprompt
      menu "prompts"
        item " &Command line" 1
        item " &One-line box" 2
        item " &Two-line box" 3
        item " &Dialog box"   4
      end
      newtype = popup (getcurrbuf) "Select a Prompt Style" 25
      if newtype then
        setobj _PromptStyle "c12d" [newtype] "prf"
      end
      destroybuf "prompts"
    end


// ───────────────────────────────────────────────────────────────────
//  Prompts and Edit windows
// ───────────────────────────────────────────────────────────────────

  object  prompt

    // support for cua-style <shift> key marking
    function  smark
      if shiftkey? then
        if _shfx then
          undobegin
          destroymark
          markstream _shfx _shfx _shfy _shfy
          _shfx = ''
          _shfy = ''
        end
        extendmark
      end
    end

    // set anchor for shift-key marking
    function  shiftdown
      _shfx = getcol
      _shfy = getrow
      pass
    end

    // end shift-key mark
    function  shiftup
      stopmark
      pass
      undoend
    end

    // backspace in a prompt
    function  backsp
      if getcol > 1 then
        left
        delchar
      end
    end

    // get the word at the cursor
    function  getword (charset column mark)
      if not column then
        column = getcol
      end
      if column <= getlinelen then
        if not charset then
          charset = _CSet
        end
        b = posnot charset (gettext column)
        if b <> 1 then
          b = if? b  column + b - 2  getlinelen
          a = posnot charset (gettext 1 column) 'r'
          a = if? a  a + 1  1
          if mark then
            undobegin
            destroymark
            markchar a b
            undoend
          else
            gettext a  b - a + 1
          end
        end
      end
    end

    // mark the word at the cursor using getword
    function  markword (charset)
      getword charset '' 1
    end

    // mark to end-of-line
    function  markeol
      undobegin
      destroymark
      if getcol <= getlinelen then
        markchar (getcol) (getlinelen)
      end
      undoend
    end

    // delete a block
    function  deleteblock2
      if getmarkbuf == getcurrbuf then
        deleteblock
      else
        if wintype? "edit" then
          if _DelLine == 'y' then
            delline
          end
        end
      end
    end

    // prompt to enter character literally
    function  literal
      say "Enter Literal..."
      queue <char> (char getkey & 0ffh)
    end

    // ascii chart with character entry
    function  asciilist
      buffer = asciibuf
      // name it so the position can be remembered
      setbufname "_asc"
      character = (popup buffer '' 13) [10]
      destroybuf
      if character then
        queue <char> character
      end
    end

    // support for file name completion (open prompts only)
    function  askcomplete
      if gethistname == "_load" then
        filespec = gettext
        if filespec then
          if not pos "*.*" filespec then
            filespec = filespec + (if? (pos '.' filespec) '*' "*.*")
          end
        else
          filespec = "*.*"
        end
        file = picklist (qualify filespec (getbufname (getwinbuf (getprevwin))))
        if file then
          col 1
          delchar (getlinelen)
          writetext file
          return file
        end
      end
    end

    // get the first line of text in the default mark
    function  getmarktext
      if mark? then
        buffer = getmarkbuf
        topline = getmarktop
        if getmarktype == 'l' then
          gettext (getlinebeg topline buffer) (getlinelen topline buffer)
                  (getmarktop) buffer
        else
          gettext (getmarkleft) (getmarkcols) topline buffer
        end
      end
    end

    // copy or copy-append to the clipboard
    function  copy (options)

      if mark? then
        currentbuf = getcurrbuf

        clip = _ClipName
        destroymark clip
        copymark (getmarkuse) clip

        // copy
        if options and (buffer? clip) then
          if getmarktype <> 'l' then
            insline '' '' (getlines clip) clip
          end
          copyblock clip clip 1 (getlines clip)
          markline 1 (getlines clip) clip clip

        // copy append
        else
          destroybuf clip
          createbuf clip
          copyblock clip clip
          if getmarktype == 'l' then
            delline 1 1 clip
          end
        end
        currbuf currentbuf
      end
    end

    // cut or cut-append to the clipboard
    function  cut (options)
      if mark? then
        copy options
        deleteblock
      end
    end

    // enter a character or string into the current prompt
    function  write (charstring)
      writetext charstring
    end


// ───────────────────────────────────────────────────────────────────
//  Edit windows
// ───────────────────────────────────────────────────────────────────

  object  edit

    // mark a paragraph
    function  markpara

      if getlinelen then

        undobegin
        destroymark

        // find the beginning of the paragraph
        pushcursor
        while up and getlinelen end
        if not getlinelen then
          down
        end
        markline
        popcursor

        // find the end of the paragraph
        pushcursor
        while down and getlinelen end
        if not getlinelen then
          up
        end
        markline
        popcursor

        undoend

        return 1
      end
    end

    // setup for insert-above (copy, move, paste - lineblocks only)
    function  begabove
      _ba = ''
      undobegin
      if _InsAbove == 'y' and getmarktype == 'l' then
        _ba = 1
        if not up then
          insabove
          up
          _ba = 2
        end
      end
    end

    // end insert-above
    function  endabove
      case _ba
        when 1 down
        when 2 delline
      end
      undoend
    end

    // paste or paste-over from the clipboard
    function  paste (options)
      if mark? _ClipName then
        destroymark
        copymark _ClipName (getmarkuse)
        if options then
          copyblockover
        else
          begabove
          copyblock
          endabove
        end
      else
        say "Nothing to paste" 'b'
      end
    end

    // clear the clipboard
    function  clear
      destroybuf _ClipName
    end

    // copy a block
    function  copyblock2
      if mark? then
        begabove
        if not copyblock then
          say "Copy failed" 'b'
        end
        endabove
      else
        if _CopyLine == 'y' then
          undobegin
          markline
          copyblock
          destroymark
          undoend
        end
      end
    end

    // move a block
    function  moveblock2
      begabove
      if getmarktop < getviewtop then
        y = 1 + getrow - (apparentrow  getviewtop - getrow)
      end
      if moveblock then
        if y then
          adjustrow y
        end
      else
        say "Move failed" 'b'
      end
      endabove
    end

    // move a block over text
    function  moveblockover
      if mark? then
        undobegin
        // use a temporary clipboard
        clip = _ClipName
        setobj ClipName 'T' 'prf'
        copy
        fillblock ' '
        paste 'o'
        setobj ClipName clip 'prf'
        destroybuf 'T'
        undoend
      end
    end

    // reformat a block or the current paragraph
    function  formatblock2 (options)
      undobegin
      if not mark? then
        if markpara "tb" then
          markcolumn (getcol) _RMargin (getmarktop) (getmarkbot)
          flag = ON
        end
      end
      // special case for single lines
      if getmarkrows == 1 and getcol < getlinebeg then
        delchar getlinebeg - getcol
      else
        formatblock _LMargin _RMargin options
      end
      if flag then
        destroymark
      end
      undoend
    end

    // simple text quoting support for a block or the current paragraph
    function  quote
      undobegin
      if not mark? then
        tempmark = TRUE
        markpara
      end
      if mark? then
        shiftblock 1 '' '>'
        if tempmark then
          destroymark
        end
      else
        say "Nothing to quote"
      end
      undoend
    end

    // sort a block
    function  sortblock2
      sortblock
        // scrollock ON=descending    // insert ON=ignore case
        (if? (shiftkey? 10h) 'd')  +  (if? (insert?) 'i')

    end

    // prompt to fill a block with a string
    function  fillblock2
      askx "Enter fill string" '' "fillblock"
    end

    // prompt to save a block
    function  saveblock2 (options)
      var c1
      var c2
      if mark? then
        file = ask "Save block as" "_load"
        if file then
          file = qualify file (getbufname)
          addhistory "_load" file
          if fileattr? file 'r' then
            say "Read Only!" 'b'
          else
            action = locase (askrac file)
            if pos action "ra" then
              send "oncomment" file ref c1 ref c2
              options = _SaveOpt + options
              if not saveblock file
                 (if? (pos 'e' options) 'e' + _TabWidth) + options +
                 (if? action == 'a' 'a')  ''
                 '' '' (if? c1 c1 + _FoldSign) c2 then
                msgbox "Save Failed!" "Error!" 'b'
              end
            end
          end
        end
      else
        say "No marked block" 'b'
      end
    end

    // left justify, center, or right justify a block
    function  justblock2 (options)
      justblock options '' _LMargin _RMargin
    end

    // destroy open and closed folds
    function  destroyfold2
      undobegin
      if not fold? then
        closefold
      end
      destroyfold
      undoend
    end

    // do fold operations on entire file
    function  foldall (options)
      undobegin
      usemark 'T'
      markline 1 (getlines)
      foldblock options
      destroymark
      usemark
      undoend
    end

    // fold a block or the current paragraph
    function  foldblock2
      undobegin
      if mark? then
        foldblock
      elseif markpara then
        foldblock
        destroymark
      end
      undoend
    end

    // fold a block and destroy subfolds
    function  foldflat
      undobegin
      foldblock 'ds'
      foldblock
      undoend
    end

    // fold or unfold a line
    function  foldline (options)
      undobegin
      usemark 'T'
      markline
      unfold = pos 'u' options
      if fold? then
        foldblock 'd'
        if not unfold or getmarkrows > 1 then
          bottom = actualrow (if? unfold -1 1) (getmarkbot)
          if not (getfold 'o' bottom) then
            markline (getrow) bottom
          end
          foldblock
        end
      else
        if not unfold then
          foldblock
        end
      end
      destroymark
      usemark
      undoend
    end

    // detab or entab the current file
    // (+width=detab, -width=entab)
    function  tabfile (width)
      undobegin
      usemark 'T'
      markline 1 (getlines)
      tabblock (if? width width _TabWidth)
      destroymark
      usemark
      undoend
    end

    // insert a line after the current line with autoindent
    function  insline2
      undobegin
      insline
      if setting? 'A' then
        if getlinelen then
          col (getlinebeg)
        else
          nextline = getrow + 2
          if getlinelen nextline then
            col (getlinebeg nextline)
          end
        end
      end
      down
      undoend
    end

    // swap the current line with the next line
    function  swapline
      undobegin
      usemark 'T'
      markline
      stopmark
      down
      moveblock
      destroymark
      usemark
      undoend
    end

    // center the current line
    function  centerline
      undobegin
      usemark 'T'
      markline
      justblock 'c' '' _LMargin _RMargin
      destroymark
      usemark
      undoend
    end

    // comment or uncomment a line
    function  commentline (c1 c2)
      if not c1 then
        send "oncomment" (getbufname) ref c1 ref c2
        if not c1 then
          c1 = '>'
        end
      end
      undobegin
      column = getlinebeg
      if (gettext column (sizeof c1)) == c1 then
        delchar (sizeof c2) getlinelen - (sizeof c2) + 1
        delchar (sizeof c1) column
      elseif getlinelen then
        instext c1 (getlinebeg)
        if column then
          ovltext c2  getlinelen + 1
        end
      end
      down
      undoend
    end

    // find the previous word
    function  prevword
      while getcol > 1 and (poschar _CSet (getchar)) do
        left
      end
      find _CSet "[r"
      while getcol > 1 and (poschar _CSet (getchar getcol - 1)) do
        left
      end
    end

    // find the next word
    function  nextword
      while poschar _CSet (getchar) do
        right
      end
      find _CSet '['
    end

    // change the case of the word at the cursor
    function  caseword (options charset)
      undobegin
      usemark 'T'
      markword charset
      caseblock options
      destroymark
      usemark
      undoend
    end

    // open the filename at the cursor
    function  openword (charset)
      file = getword (if? charset charset _CSetB)
      if file then
        open file
      end
    end

    // delete the character at the cursor
    function  delchar2
      undobegin
      if getcol > getlinelen and _DelJoin == 'y' then
        joinline
      else
        delchar
        if setting? 'L' then
          livewrap
        end
      end
      undoend
    end

    // backspace
    function  backsp
      undobegin
      if getcol > 1 then
        left
        if not insert? and _BakOvl == 'y' then
          ovltext ' '
        else
          delchar
          if setting? 'L' then
            livewrap
          end
        end
      elseif getrow > 1 and _BakJoin == 'y' then
        up
        col getlinelen + 1
        joinline
      end
      undoend
    end

    // delete right word
    function  delword (charset)
      if not charset then
        charset = _CSet
      end
      undobegin
      if getcol > getlinelen then
        joinline
      else
        p = posnot charset (gettext (getcol))
        if p > 1 then
          delchar p - 1
        end
        delchar (
          if p then
            if getchar == ' ' and
                 (getcol == 1 or
                 (posnot charset (getchar getcol - 1))) then
              (posnot ' ' (gettext (getcol))) - 1
            else
              p == 1
            end
          else
            getlinelen
          end
        )
      end
      if setting? 'L' then
        livewrap
      end
      undoend
    end

    // splitline with autoindent
    function splitline2 (column)
      undobegin
      b = getlinebeg
      if splitline column then
        if not setting? 'A' then
          b = _LMargin
        end
        if b > 1 then
          pushcursor
          down
          usemark 'T'
          markline
          shiftblock (if? getcol > b  b  (getcol)) - 1
          destroymark
          usemark
          popcursor
        end
      end
      undoend
    end

    // <enter> key behavior
    function  enter

      // terminate a word for text translation
      lastrow = getrow
      if getcol == getlinelen + 1 and getlinelen then
        if setting? 'T' then
          send <char> ' '
        end
      end

      if getrow == lastrow then
        case (if? (insert?) _EnterIns _EnterOvl)
          when 'i'
            insline2
          when 's'
            if fold? then
              insline2
            else
              startcolumn = getlinebeg
              length = getlinelen
              splitline2
              down
              if setting? 'A' then
                if length then
                  col startcolumn
                end
              else
                startcolumn = _LMargin
                col (if? startcolumn startcolumn 1)
              end
            end
          otherwise
            down
            col (if? (getlinelen) (getlinebeg) _LMargin)
        end
      end
    end

    // for use by variable tab right
    function  vtabr
      i = 1
      while i <= arg do
        if (arg i) <= getcol then
          i = i + 1
        else
          return arg i
        end
      end
      return 0
    end

    // for use by variable tab left
    function  vtabl
      i = arg
      while i do
        if (arg i) >= getcol then
          i = i - 1
        else
          return arg i
        end
      end
      return 0
    end

    // tab support
    function  tabfunc (next)

      oldcolumn = getcol

      // smart tabs
      if setting? 'S' then
        prevline = getrow - 1
        while prevline and not (getlinelen prevline) do
          prevline = prevline - 1
        end
        if prevline then
          pushcursor
          row prevline
          send (if? next "nextword" "prevword")
          if prevline == getrow then
            newcolumn = getcol
          end
          popcursor
        end
      end

      // variable tabs
      if not newcolumn then
        if setting? 'V' then
          newcolumn = eval (if? next "vtabr " "vtabl ") + _VarTabs
        end

        // standard interval tabs
        if not newcolumn then
          width = _TabWidth
          if not width then
            width = 8
          end
          newcolumn = oldcolumn +
                        if next then
                          width - (oldcolumn - 1) mod width
                        elseif oldcolumn > 1 then
                          -((oldcolumn - 2) mod width + 1)
                        end
        end
      end

      // move to tabstop and shift text if needed
      if newcolumn then
        if _TabShift == 'y' and insert? then
          if newcolumn < oldcolumn then
            delchar  oldcolumn - newcolumn  newcolumn
          elseif newcolumn > oldcolumn then
            instext (copystr ' ' newcolumn - oldcolumn)
          end
        end
        col newcolumn
      end
    end

    // tab left and right
    function  tabright    tabfunc 1  end
    function  tableft     tabfunc    end

    // prompt to verify close
    function  close?
      if bufchanged? and not getprevcurs then
        savechanges = popup "ync"  "Save changes to " +
                                        (getname (getbufname)) + '?'
        if savechanges == "Yes" then
          save
        end
        icompare savechanges "Yes" "No"
      else
        1
      end
    end

    // close an edit window
    function  close (options)
      if pos 's' options then
        if save then
          pass
        end
      elseif close? then
        pass
      end
    end

    // open and insert prompt
    function  askinsert
      file = ask  "File to insert into " + (getname (getbufname)) "_load"
      if file then
        // addhistory not needed for open
        old_size = getlines
        undobegin
        open file 'i'
        // mark the inserted text
        if not (dir? (getbufname)) then
          if getlines > old_size then
            markline  getrow + 1  getrow + getlines - old_size
          end
        end
        undoend
      end
    end

    // prompt to change the current file name
    function  askname
      newname = ask  "Rename " + (getname (getbufname)) + " to"  "_load"
      if newname then
        case setname newname
          when -1 say "Failed" 'b'
          when -2 say "Failed - file already loaded" 'b'
          otherwise
            addhistory "_load" (getbufname)
        end
      end
    end

    // search and replace with messages and highlighting
    function  search2 (search_str reverse again)
      var opt
      var rpl
      n = search search_str reverse again ref opt ref rpl
      if n then
        // replace occurred
        if rpl then
          display
          say (thousands n) + " changes made"
        // count occurrences
        elseif pos 'a' opt then
          display
          say (thousands n) + " occurrences of '" + search_str + "' found"
        // search only
        else
          onfound n
        end
      else
        display
        say "'" + search_str + "' not found"  'b'
      end
      return n
    end

    // find prompt
    function  askfind (reverse)
      search_string = if _PromptStyle == 'd' then
                        finddlg
                      else
                        ask "[string/abgirswx] Find"  "_find"
                      end
      if search_string then
        search2 search_string reverse
        addhistory "_find" search_string
      end
    end

    // replace prompt
    function  askrepl (reverse)
      search_string = if _PromptStyle == 'd' then
                        repldlg
                      else
                        ask "[string/replstr/abgirswx] Repl"  "_find"
                      end
      if search_string then
        search2 search_string reverse
        addhistory "_find" search_string
      end
    end

    // do the last find/replace operation
    // (reverse=r reverses the search direction)
    function  findlast (reverse)
      search2 (gethiststr "_find") reverse TRUE
    end

    // incremental search
    function  isearch

      var search_string

      repeat

        settitle  "I-search for [" + search_string + "] "
        keycode = getkey
        options = _SearchOpt
        new_char = ''

        case  keycode

          when <backspace>
            if search_string then
              popcursor
              search_string = if (sizeof search_string) > 1 then
                                search_string [1 : (sizeof search_string) - 1]
                              else
                                ''
                              end
              if not search_string then
                display
              end
              options = '*'
            end

          when <ctrl p>, <ctrl r>
            options = 'r'

          when <ctrl n>, <ctrl l>
            // do nothing

          when <ctrl g>, <ctrl b>
            options = 'g'

          otherwise
            keyname = getkeyname keycode
            if (sizeof keyname) == 3 then
              pushcursor
              new_char = keyname [2]
              options = '*'
            else

              // restore window title
              settitle (getbufname)
              display

              // clear all pushed cursors
              popcursor "ad"
              addhistory "_find" search_string

              if keycode <> <enter> and keycode <> <esc> then
                queuekey keycode
              end

              done = TRUE
            end
        end

        if not done and (search_string or new_char) then
          new_string = concat search_string new_char
          str_length = find new_string  _SearchOpt + options
          if str_length then
            onfound str_length
            search_string = new_string
          else
            say  new_string + " not found"  'b'
            if new_char then
              popcursor
            end
            onfound (sizeof search_string)
          end
        end

      until done
    end


    // find occurrences search
    function  findo (string_and_opt)

      var search_string
      var options
      var o

      n = splitstr '' string_and_opt
                   ref search_string  ref options  ref o

      // initialize search options
      if n >= 2 then
        if n > 2 then
          options = o
        end
      else
        options = _SearchOpt
      end
      if pos 'g' options then
        options = sub 'g' '' options
      end
      options = options + '*'

      // do the search
      buffer = createbuf
      ovltext "≡≡≡≡≡≡ Select this line to edit occurrences ≡≡≡≡≡≡"
      gotobuf (getprevbuf)
      pushcursor
      gotopos 1 1
      while find  search_string options  do
        addline  getrow + ": " + gettext  '' '' buffer
        col MAX_COL
      end
      popcursor

      // display occurrences
      if (getlines buffer) > 1 then
        bname = getbufname
        line = popup buffer
                 "Occurrences of '" + search_string + "' in "
                 + (getname bname) + " - " + ((getlines buffer) - 1) +
                 " lines"   getvidcols - 11 getvidrows - 8
        if line then
          if line [1] == '≡' then
            delline 1 1 buffer
            setbufname (qualify "TEMP.TXT" bname) buffer
            openbuf buffer
          else
            destroybuf buffer
            gotopos 1 line [1 : (pos ':' line) - 1]
            onfound (find search_string  options + '*')
          end
        end
      else
        destroybuf buffer
        display
        say  "'" + string_and_opt + "' not found"  'b'
      end
    end

    // prompt to find occurrences
    function  askfindo
      search_str = ask "[string/birswx] Find occurrences of"  "_find"
      if search_str then
        findo search_str
        addhistory "_find" search_str
      end
    end

    // find all occurrences of last find string
    function  findlasto
      findo (gethiststr "_find")
    end

    // find matching character (){}[]<>
    function  gotomatch2
      if gotomatch "(){}[]<>" then
        onfound 1
      else
        say "Not found" 'b'
      end
    end

    // goto column
    function  col2 (column)
      case column [1]
        when '+'   right  column [2 : TO_END]
        when '-'   left   column [2 : TO_END]
        otherwise  col (if? column > MAX_COL MAX_COL column)
      end
      onfound
    end

    // goto line
    function  row2 (line)
      case line [1]
        when '+'   down line [2 : TO_END]
        when '-'   up   line [2 : TO_END]
        otherwise  row (if? line > getlines (getlines) line)
      end
      onfound
    end

    // goto line prompt
    function  askrow
      askx "Line number" "_line" "row2"
    end

    // goto column prompt
    function  askcol
      askx "Column Number" '' "col2"
    end

    // set a quick bookmark
    function  quickbook
      _bk = _bk + 1
      bookmark = "Book" + _bk
      setbook bookmark
      display
      say "Bookmark " + bookmark + " set"
    end

    // place a bookmark
    function  placebook (bookmark)
      if not bookmark then
        bookmark = ask "Bookmark Name" "_book"
      end
      if bookmark then
        setbook bookmark
        display
        say "Bookmark '" + bookmark + "' set"
      end
    end


    // Go to the compiler error on the current line of a compiler
    // error output file. This function recognizes compiler errors
    // of the form:
    //
    //   <text>  FILENAME.EXT  <text>  LINENUMBER  <text> : MESSAGE
    //
    // (implemented by using regular expression searching confined
    // to the current line)

    function  gotoerror
      pushcursor
      // filename charclass to use (max closure without the period)
      fileset = "[a-zA-Z0-9_\-/\\\\@~:^!#$%&`']#"
      file_ext =  fileset + '\\.' + fileset
      // find the filename
      length = find file_ext 'xgl*'
      if length then
        filename = gettext (getcol) length
        right length
        // find the line number
        length = find "[0-9]#" 'xl'
        if length then
          line = gettext (getcol) length
          // find the message
          if find ':' 'l' then
            message = gettext getcol + 1
            popcursor
            // open the file
            if open filename then
              row line
              col (getlinebeg)
              send "onfound"
              say  message + '  '
              return
            end
          end
        end
      end
      popcursor
      display
      say "Compiler message not recognized."
    end


    // backup a file and return the backup filename if sucessful
    function  backup (file)
      if locatefile file then
        dir = _BackupDir
        if dir then
          if (sizeof dir) > 3 and  dir [LAST_CHAR] == "\\" then
            dir = dir [1 : (sizeof dir) - 1]
          end
          createdir dir
          dir = qualify dir
          backup_file = if pos "*.*" dir then
                          qualify (getname file) dir
                        else
                          msgbox "Unable to create backup file!"
                                 "Warning!"
                          return 1
                        end
        else
          backup_file = forceext file _BackupExt
        end

        // delete the old backup file
        deletefile backup_file

        // attempt a rename
        if not renamefile file backup_file then
          // try copy if rename fails
          if (copyfile file backup_file) <= 0 then
            msgbox "File backup failed!" "Error"
            return 0
          end
        end
        return backup_file
      else
        return 1
      end
    end

    // save the current file to disk
    function  save (file options)
      var c1
      var c2

      // check for a truncated file
      if trunc? and
         not (icompare (popup "ok" "Truncated file - are you sure?") "Ok") then
        return
      end

      file = if file then
               qualify file (getbufname)
             else
               getbufname
             end
      if fileattr? file 'r' then
        say "Read Only!" 'b'
      else
        backup_file = 1
        if setting? 'B' then
          backup_file = backup file
        end
        if not backup_file then
          say "Backup failed" 'b'
        else
          send "onsave" file

          // get fold comments for the file (if any)
          send "oncomment" file ref c1 ref c2
          options = _SaveOpt + options
          if not savebuf file
                   (if? (pos 'e' options) 'e' + _TabWidth) + options  ''
                   (if not getbinarylen then hex2bin _LineDlm end) ''
                   (if? c1 c1 + _FoldSign) c2 then

            // restore the backup after save failure
            if backup_file <> 1 then
              if not renamefile backup_file file then
                copyfile backup_file file
              end
            end
            msgbox "Save failed!  Check file path / file attributes / disk space"  "Error!" 'b'
            return 0
          else
            1
          end
        end
      end
    end

    // save-as prompt
    function  asksaveas (options)
      file = ask "Save " + (getname (getbufname)) + " as"  "_load"
      if file then
        file = qualify file (getbufname)
        addhistory "_load" file
        save file options
      end
    end

    // start, stop, or do autosave
    function  autosave (seconds)
      if not seconds then
        if bufchanged? then
          save
        end
      elseif seconds < 0 then
        destroytimer "asav"
      else
        setrepeat "asav" seconds * 1000  '' "autosave"
      end
    end

    // prompt for autosave interval in seconds
    function  askasave
      seconds = ask "Autosave interval in secs (-1=disable)"
      if seconds then
        autosave seconds
      end
    end

    // highlight all occurrences of the word at the cursor
    function  hiliteword
      sobj = send "onsyntax" (getbufname)
      if not sobj then
        setting 'X' DEFAULT
        sobj = "syndef"
      end
      if sobj then
        w = send "getword" "a-zA-Z_0-9?"
        if w then
          // create a color selection menu
          menu "hcolor"
            item " &None"           -1
            item " &Default"        -2
            item "-"
            item " &Black"          color white on black
            item " B&lue"           color yellow on blue
            item " &Green"          color white on green
            item " &Cyan"           color white on cyan
            item " &Red"            color white on red
            item " &Magenta"        color white on magenta
            item " Br&own"          color white on brown
            item " Gr&ay"           color white on gray
            item "-"
            item " Dar&kgray"       color white on darkgray
            item " Brightbl&ue"     color white on brightblue
            item " Brightgr&een"    color black on brightgreen
            item " Brig&htcyan"     color black on brightcyan
            item " Br&ightred"      color white on brightred
            item " Brightmagen&ta"  color white on brightmagenta
            item " &Yellow"         color black on yellow
            item " &White"          color black on white
          end
          setbufname "colorlist"
          hcolor = popup "hcolor" "select a color "
          // destroy the menu
          destroybuf "hcolor"
          if hcolor then
            if hcolor == -1 then
              unsetx w sobj
            else
              setxobj w (if? hcolor == -2 '' hcolor) sobj
            end
          end
          display
        end
      end
    end

    // live word wrap support
    function  livewrap

      if fold? then
        return
      end

      startcol = getlinebeg
      if getrow < getlines and (getlinelen  getrow + 1) then
        n = getlinebeg  getrow + 1
        startcol = if? n < startcol  n  startcol
      elseif not getlinelen or not (setting? 'A') then
        startcol = _LMargin
      end

      if getcol < startcol then
        startcol = getcol
      end

      if getlinelen then
        undobegin
        saved_char = getchar
        ovltext '■'

        // mark to the end of the paragraph
        pushcursor
        top = getrow
        while down and getlinelen do end
        if not getlinelen then
          up
        end
        bottom = getrow
        popcursor

        // reformat
        usemark 'T'
        markcolumn startcol _RMargin top bottom
        formatblock '' '' "kr"
        destroymark
        usemark

        // find the original cursor position
        col 1
        find '■' '*'
        ovltext (if? saved_char saved_char ' ')

        undoend
      end
    end

    // enter a character or string at the cursor, with support for:
    //   - match character
    //   - translate
    //   - standard word wrap
    //   - live word wrap

    function  write (write_str)

      // group together as one undoable operation
      undobegin

      // enter the character or string at the cursor and
      // advance the cursor
      writetext write_str

      // get the current window settings
      setting_str = getsettings

      // match character
      if pos 'M' setting_str then
        instext ( case write_str
                    when '"'  '"'
                    when '('  ')'
                    when '['  ']'
                    when '{'  '}'
                    otherwise ''
                  end )
      end

      // translate
      if pos 'T' setting_str then

        // delimited lookup?
        to_word_end = if? (posnot _TranCSet write_str) 2 1

        // get the last word typed
        word_str = getword _TranCSet (getcol - to_word_end)
        if word_str then
          lookup_str = word_str + (if? to_word_end == 2 '*')

          // lookup the word in the translate object
          value = lookup lookup_str _TranObj

          if value then
            // is it a function? ..then evaluate it
            if function? lookup_str _TranObj then
              eval value

            // otherwise replace the word
            else
              word_column = getcol - (sizeof word_str) - to_word_end + 1
              delchar (sizeof word_str) word_column
              instext value word_column
              col word_column + (sizeof value) + to_word_end - 1
            end
          end
        end
      end

      // check for word wrap and live wrap
      if getlinelen > _RMargin then

        // live word wrap
        if pos 'L' setting_str then
          livewrap

        // standard word wrap
        elseif (pos 'W' setting_str) and (not fold?) then
          column = getcol
          limit = _RMargin + 1
          if column > limit then
            if write_str <> ' ' then
              first_col = if? (setting? 'A') (getlinebeg) _LMargin
              split_col = pos ' ' (gettext 1 limit) 'r'
              split_col = if? split_col > first_col  split_col + 1  limit
              splitline split_col
              down
              markline '' '' 'T'
              shiftblock  first_col - 1 'T'
              destroymark 'T'
              col  column - split_col + first_col
            end
          end
        end
      end

      undoend
    end

    // enter a date/time stamp at the cursor
    function  timestamp
      write getdate + ' ' + gettime
    end


// ───────────────────────────────────────────────────────────────────
//  File Manager windows
// ───────────────────────────────────────────────────────────────────

  object  fmgr

    // return the file name for fmgr commands
    function  fname2
      if fmark? then
        "MARKED FILES"
      else
        getname (getffile)
      end
    end

    // error notification
    function  ferror (s)
      msgbox  s + " Failed"  "Error!" 'b'
    end

    // fmgr confirmation prompt
    function  fconfirm (confirm pstring func)
      if (icompare confirm 'n') or
         (icompare (popup "ok" pstring + ' ' + fname2 + '?') "ok") then
        fdomark func
        reopen
      end
    end

    // internal fopen
    function  fopn (file options)
      if file then
        openf file options
      else
        fdomark "fopn" options
      end
    end

    // fmgr open file(s) command
    function  fopen (options)

      var searchopt

      if pos '1' options then
        if shiftkey? then
          options = options + 'v'
        end
        scanstr = fscanstr
        openf '' options

        // find first occurrence for scan windows
        if scanstr then
          addhistory "_find" scanstr
          splitstr '' scanstr '' ref searchopt
          gotopos 1 (if? (pos 'r' searchopt) (getlines) 1)
          send "onfound" (search scanstr)
        end

      else
        fopn '' options
      end
    end

    // fmgr change file attributes command
    function  fattr (file attr)
      if file then
        chgfileattr file attr
      else
        attr = ask "New attributes [AHSR] for " + fname2
        if attr then
          fdomark "fattr" (if? attr <> ' ' attr)
          reopen
        end
      end
    end

    // fmgr delete file(s) command
    function  fdelete (file)
      if file then
        if pos "*.*" file then
          file = getpath file
        end
        if not deletefile file 'd' then
          ferror "Delete"
        end
      else
        fconfirm _ConDel "Delete" "fdelete"
      end
    end

    // fmgr touch file(s) command
    function  ftouch (file)
      if file then
        if not touchfile file then
          ferror "Touch"
        end
      else
        fconfirm _ConTch "Touch" "ftouch"
      end
    end

    // print a file or directory with the current printer settings
    function  printfile (file)
      if loadbuf file '' '' _FmgrOpt _TruncLength then
        print
        destroybuf
      end
    end

    // fmgr print file(s) command
    function  fprint (file)
      if file then
        if not printfile file then
          ferror "Print"
        end
      else
        fconfirm 'y' "Print" "fprint"
      end
    end

    // fmgr run file command
    function  frun (options)
      run (getffile) options
      reopen
    end

    // fmgr rename file command
    function  frename
      oldname = getffile
      newname = ask  "Rename " + (getname oldname) + " to"  "_load"
      if newname then
        if renamefile oldname (qualify newname (getbufname)) then
          reopen
        else
          ferror "Rename"
        end
      end
    end

    // fmgr copy (or move) file(s) command
    function  fcopy (source dest options)
      if source then
        if dir? dest then
          dest = qualify (getname source) dest
        end
        action = askrac dest
        if pos action "ra" 'i' then
          move? = options == 'm'
          say (if? move? "Mov" "Copy") + "ing " + source "..."
          if not move? or (icompare action 'a') or not (renamefile source dest) then
            if not copyfile source dest (if? (icompare action 'a') 'a') then
              ferror (if? move? "Move" "Copy")
              fdobrk
            else
              if move? then
                deletefile source
              end
            end
          end
        end
      else
        if fmark? then
          dir_dest = qualify (getffile)
          if not dir? dir_dest then
            dir_dest = ''
          end
        end
        dest = ask (if? options == 'm' "Move " "Copy ") + fname2 + " to"
                   "_load" dir_dest
        if dest then
          fdomark "fcopy" (qualify dest (getbufname)) options
          reopen
        end
      end
    end

    // fmgr move file(s) command
    function  fmove
      fcopy '' '' 'm'
    end

    // fmgr create new directory command
    function  fmkdir
      dir = ask "New directory name" "_load"
      if dir then
        if createdir (qualify dir (getbufname)) then
          reopen
        else
          ferror "Create directory"
        end
      end
    end


// ───────────────────────────────────────────────────────────────────
//  On-Event functions called by the editor
// ───────────────────────────────────────────────────────────────────

  // edit windows & file manager windows only
  object  edit_fmgr

    // called while loading files
    function  onloading (lines)
      say (if? lines  "Loading [" + lines + "]..."  getbufname)
    end

    // called while saving files
    function  onsaving (lines)
      say (if? lines  "Saving [" + lines + "]..."  getbufname)
    end

    // called while printing files
    function  onprinting (lines)
      say (if? lines  "Printing [" + lines + "]... <ctrl break> to stop "
           getbufname)
    end

    // called while scanning files
    function  onscanning (file found)

      // create scan progress window
      if not window? 'scan' then

        createwindow 'scan'
        setwinobj
        setframe ">b"
        setcolor  border_color   color white on gray
        setcolor  text_color     color black on gray
        settitle "Scanning" 'c'
        setborder "1i"
        setshadow 2 1

        // center the window
        width = (sizeof (getpath file)) + 24
        height = 16
        ox = (getvidcols - width) / 2
        oy = (getvidrows - height) / 2
        sizewindow ox oy ox + width oy + height "ad"
        writestr   file + "..."

      elseif found then
        writestr " FOUND" (color brightgreen on gray) (getcoord 'x1') - 7

      elseif file then
        writeline
        writestr   file + "..."

      else
        destroywindow
      end

      display
    end

    // called while compiling files
    function  oncompiling (file lines)
      say (if? lines  "Compiling " + file + " [" + lines + "]..."  getbufname)
    end


  // edit windows only
  object  edit

    // called after a file is opened and before it's displayed
    function  onopen

      // set window event object
      setwinobj "edit"

      // default window settings (if not remembered by open)
      if not getsettings then
        setting _DefaultSet ON
      end

      // check for file truncation
      if trunc? then
        display
        say "File Truncated!" 'b'
      end
    end

    // called immediately before a file is saved
    //function  onsave (file) then
    //end

    // called when switching to a file
    //function  onfocus
    //end

    // called when closing a file
    //function  onclose
    //end

    // called after a search to change the window view and
    // optionally highlight a string
    function  onfound (stringlength)

      // check if the cursor is outside the window view
      if getcol < getviewleft then
        if getcol < getviewcols then
          rollcol -getviewleft
        else
          adjustcol 3
        end
      elseif getcol + stringlength >= getviewright then
        adjustcol
      end

      if getrow > getviewbot then
        adjustrow 3
      elseif getrow < getviewtop then
        adjustrow
      end
      display

      // highlight a string if stringlength is specified
      if stringlength then
        hilite stringlength 1 (getpalette (if? (inmark?) 9 8))
      end
    end


  object  fmgr

    // called after a fmgr window is opened and before it's displayed
    function  onopen

      // set the window event object
      setwinobj "fmgr"

      // check for include picklist
      if ftype? 'i' then
        display
        say "Select file to insert"
      end
    end


  // all windows
  object  a

    // called when sounding an alarm
    // (allows you to customize the alarm sound)
    function  onalarm
      beep 750 70
    end

    // get default comments for a filename (c1, c2 passed by reference)
    // (associates a filename with comment symbols)
    function  oncomment (file c1 c2)
      case getext (upcase file)
        when ".C", ".AML", ".CPP", ".H"   c1 = "//"
        when ".ASM"                       c1 = ';'
        when ".PAS"                       c1 = '{'   c2 = '}'
        otherwise                         c1 = '>'
      end
    end


    // called when entering the editor before any windows are open.
    // DOS command-line filespecs are passed to this function
    function  onentry

      // save the DOS entry path
      _cp = getcurrpath

      // open prompt and window history
      if _SaveHistory == 'y' then
        openhistory (bootpath "history.dat")
      end

      // process command-line parameters passed to the editor
      param_num = 1
      parameter = arg 1

      while parameter do

        // check for command line options
        if parameter [1:2] == "-e"  then
          queue parameter [3 : TO_END]

        // open files/directories
        else
          open parameter
        end

        // next command line parm
        param_num = param_num + 1
        parameter = arg param_num
      end

      // still no windows open? then do bootoptions...
      if not getcurrwin then
        case _BootOpt
          when 'd'  restoredesk
          when 'f'  open '.'
          when 'n'  opennew
          otherwise
            filespec = ask "File or Directory" "_load"
            if filespec then
              open filespec
            else
              halt
            end
        end
      end

      // initialize the mouse
      if _Mouse == 'y' then
        if openmouse _MouseOpt then
          mousepos  15999 + getvidcols  15999 + getvidrows
          y_sens = _MouSenY
          if (getos 'v') > 9 then
            mousesense (_MouSenX * 5) / 8  (y_sens * 5) / 8  _MouDST
          else
            mousesense _MouSenX y_sens _MouDST
          end
        end
      end

      // open key macros if configured
      if _SaveMac == 'y' then
        openkey (bootpath "a.mac")
      end

      // set autosave timer
      send "autosave" _AutoSave
    end


    // called when exiting the editor after all windows are closed
    function  onexit

      // open prompt on non-global exit (if configured)
      if not __G then
        if _ExitOpen == 'y' then
          filespec = ask "File or Directory" "_load"
          if filespec then
            open filespec
          end
        end
      end

      // final exit if no windows open
      if not getcurrwin then

        // save prompt and window history
        if _SaveHistory == 'y' then
          savehistory (bootpath "history.dat")
        end

        // save key macros if configured
        if _SaveMac == 'y' then
          // check if record occurred
          if lookup "kd" "mon" then
            savekey (bootpath "a.mac")
          end
        end

        // restore entry path saved in onentry
        currpath _cp

        closemouse
        halt
      end
    end